Magnum One/Magnum One (Mid-American Digital) (Disc Manufacturing).iso/d18/opbonus.arc/DUPFIND.ARC/DUPFIND.PAS

Pascal/Delphi Source File | 1991-03-20 | 15KB | 557 lines

{************************************************************************
 Find all files with duplicate names on specified drive(s) and write a list
 of them. Run DUPFIND without command line parameters to get help.

 Requires the commercial product Object Professional to compile.

 DUPFIND provides the following general-purpose objects:
   Tree - a binary tree (in OPTREE.PAS)
   WildMatcher - a string matcher that understands * and ?

 Written 1/13/90, Kim Kokkonen, TurboPower Software
 CompuServe ID [76004,2611]
************************************************************************}

{$R-,S-,I-,V-,B-,F-}

program DupFind;
  {-Find duplicate files}

uses
  Dos, OpString, OpDos, OpRoot, OpTree;

const
  FileAttr = AnyFile;         {File attributes being checked}

type
  FileStr = String[12];

  DirNodePtr = ^DirNode;
  DirNode =
    object(SingleListNode)
      Time : Longint;         {Date/time stamp of file in this directory}
      Size : Longint;         {Size of file in this directory}
      DNameP : StringPtr;     {Pointer to name of directory}
      constructor Init(FileTime, FileSize : Longint; Dirname : PathStr);
        {-Initialize a DirNode}
      destructor Done; virtual;
        {-Destroy a DirNode}
    end;

  FileNodePtr = ^FileNode;
  FileNode =
    object(TreeNode)
      NameP : StringPtr;      {Pointer to name of file}
      DirList : SingleList;   {List of DirNodes}
      constructor Init(FileName : FileStr);
        {-Initialize a FileNode}
      destructor Done; virtual;
        {-Destroy a FileNode}
    end;

  FileTreePtr = ^FileTree;
  FileTree =
    object(Tree)
      ftUnique : LongInt;     {Number of uniquely named files in tree}
      ftTotal : LongInt;      {Total number of files in tree}
      constructor Init;
        {-Initialize FileTree}
      procedure FileInsert(FileName : FileStr;
                           FileTime, FileSize : LongInt;
                           Dirname : PathStr);
        {-Add a file and directory name to the tree list}
      procedure DumpDups;
        {-Dump files that appear at least twice}
      procedure GetCounts(var Unique, Total : LongInt);
        {-Return the number of unique names and the total number of names}
      {-- override virtual methods required by Tree object --}
      function Compare(Key1, Key2 : Pointer) : CompareType; virtual;
        {-Compare two keys, returning Less, Equal, Greater}
      function GetKey(N : TreeNodePtr) : Pointer; virtual;
        {-Return a pointer to the key value for node N}
    end;

const
  AnyChar = '*';         {Match zero or more characters}
  OneChar = '?';         {Match exactly one character}
  EndChar = #255;        {Terminator to match strings}

type
  WildMatcherPtr = ^WildMatcher;
  WildMatcher =
    object(Root)
      maCase : Boolean;       {True if case-sensitive matching}
      maMask : String[128];   {Mask used for matching}
      constructor Init(Mask : String; CaseSensitive : Boolean);
        {-Initialize the mask string. May fail if Mask is invalid}
      function Matches(Name : String) : Boolean;
        {-Return True if Name matches Mask}
      function GetMask : String;
        {-Return the simplified mask}
      procedure SimplifyMask;
        {-Used internally to simplify mask when object instantiated}
    end;

var
  StdErr : Text;              {File where messages are written}
  FileNames : FileTree;       {Stores all the files}
  FileMask : WildMatcher;     {Used for wildcard matching}
  DefaultMask : Boolean;      {True if mask is *.* and FileMask isn't used}

procedure WriteCopyright;
begin
  WriteLn(StdErr,
  'DUPFIND 1.0 - Duplicate file finder. Copyright (c) TurboPower Software, 1990'^M^J);
end;

procedure WriteHelp;
  {-Write a help message and halt}
begin
  WriteLn('Usage: DUPFIND Drive [Drive ...] [/S FileMask] [>OutputRedirection]');
  WriteLn;
  WriteLn('DUPFIND creates an alphabetized list of all duplicate files on the');
  WriteLn('specified disk drives. One or more valid drive letters must be given.');
  WriteLn;
  WriteLn('By default, DUPFIND scans all files on the drives. Use the /S option');
  WriteLn('to limit the search. FileMask is an exact filename or an extended DOS');
  WriteLn('wildcard pattern like *.PAS or OP??????.* or even ARC*X.*');
  WriteLn;
  WriteLn('DUPFIND writes a report to standard output. The report looks like the');
  WriteLn('following:');
  WriteLn('  README.COM');
  WriteLn('        4217 89/06/28 05:50:00 c:\t55\rtl');
  WriteLn('        4200 88/08/29 05:00:00 c:\t5');
  WriteLn('  README.DOC');
  WriteLn('       18520 89/04/25 10:01:04 c:\word');
  WriteLn('        2405 89/05/05 10:14:24 c:\qp');
  WriteLn('which shows the size, date, time, drive, and directory of the dup files.');
  WriteLn;
  WriteLn('The following command line');
  WriteLn('  DUPFIND C D E /S READ*.* >JUNK');
  WriteLn('searches drives C, D, and E for all files starting with READ');
  Halt;
end;

procedure Abort(Msg : String);
  {-Report error message and abort}
begin
  WriteLn(StdErr, Msg);
  Halt(1);
end;

procedure InsufficientMemory;
  {-Report insufficient memory and abort}
begin
  Abort('Insufficient memory');
end;

constructor DirNode.Init(FileTime, FileSize : Longint; Dirname : PathStr);
  {-Initialize the node}
begin
  if not SingleListNode.Init then
    Fail;
  DNameP := nil;
  if not GetMemCheck(DNameP, Length(Dirname)+1) then begin
    Done;
    Fail;
  end;
  DNameP^ := Dirname;
  Time := FileTime;
  Size := FileSize;
end;

destructor DirNode.Done;
  {-Destroy the node}
begin
  if DNameP <> nil then
    FreeMem(DNameP, Length(DNameP^)+1);
  SingleListNode.Done;
end;

constructor FileNode.Init(FileName : FileStr);
  {-Initialize a FileNode}
begin
  if not TreeNode.Init then
    Fail;
  NameP := nil;
  if not(DirList.Init and GetMemCheck(NameP, Length(FileName)+1)) then begin
    Done;
    Fail;
  end;
  NameP^ := FileName;
end;

destructor FileNode.Done;
  {-Destroy a FileNode}
begin
  if NameP <> nil then
    FreeMem(NameP, Length(NameP^)+1);
  DirList.Done;
end;

constructor FileTree.Init;
  {-Initialize FileTree}
begin
  ftUnique := 0;
  ftTotal := 0;
  if not Tree.Init then
    Fail;
end;

procedure FileTree.FileInsert(FileName : FileStr;
                              FileTime, FileSize : LongInt;
                              Dirname : PathStr);
  {-Add a file and directory name to the tree list}
var
  DirIndex : Word;
  FileNP : FileNodePtr;
  DNodeP : DirNodePtr;
begin
  {See if filename is already in tree}
  FileNP := FileNodePtr(Find(@FileName));
  if FileNP = nil then begin
    {Insert filename in tree}
    New(FileNP, Init(FileName));
    if FileNP = nil then
      InsufficientMemory;
    Insert(FileNP);
    Inc(ftUnique);
  end;

  {Create a directory node to add to the dictionary}
  New(DNodeP, Init(FileTime, FileSize, Dirname));
  if DNodeP = nil then
    InsufficientMemory;

  {Add directory node to list}
  FileNP^.DirList.Append(DNodeP);

  inc(ftTotal);
end;

function FileTree.Compare(Key1, Key2 : Pointer) : CompareType;
  {-Compare two keys, returning Less, Equal, Greater}
begin
  Compare := CompString(StringPtr(Key1)^, StringPtr(Key2)^);
end;

function FileTree.GetKey(N : TreeNodePtr) : Pointer;
  {-Return a pointer to the key value for node N}
begin
  GetKey := FileNodePtr(N)^.NameP;
end;

function DateTimeStr(DT : LongInt) : String;
  {-Return a formatted date-time string}
type
  String2 = String[2];
var
  T : DateTime;

  function W2S2(W : Word) : String2;
  var
    S : String2;
  begin
    Str((W mod 100):2, S);
    if S[1] = ' ' then
      S[1] := '0';
    W2S2 := S;
  end;

begin
  UnpackTime(DT, T);
  with T do
    DateTimeStr := W2S2(Year)+'/'+W2S2(Month)+'/'+W2S2(Day)+' '+
                   W2S2(Hour)+':'+W2S2(Min)+':'+W2S2(Sec);
end;

{$F+}
procedure DumpNode(N : TreeNodePtr; T : TreePtr);
  {-Dump one tree node}
var
  DNodeP : DirNodePtr;
begin
  if FileNodePtr(N)^.DirList.Size >= 2 then begin
    {At least two instances of file, write the filename}
    WriteLn(FileNodePtr(N)^.NameP^);
    {Scan the list of directories}
    DNodeP := DirNodePtr(FileNodePtr(N)^.DirList.Head);
    while DNodeP <> nil do begin
      WriteLn('  ', DNodeP^.Size:8, ' ', DateTimeStr(DNodeP^.Time), ' ',
              StLocase(DNodeP^.DNameP^));
      DNodeP := DirNodePtr(FileNodePtr(N)^.DirList.Next(DNodeP));
    end;
  end;
end;
{$F-}

procedure FileTree.DumpDups;
  {-Dump files that appear at least Min times}
begin
  VisitNodesUp(DumpNode);
end;

procedure FileTree.GetCounts(var Unique, Total : LongInt);
  {-Return the number of unique names and the total number of names}
begin
  Unique := ftUnique;
  Total := ftTotal;
end;

constructor WildMatcher.Init(Mask : String; CaseSensitive : Boolean);
  {-Initialize the mask string. May fail}
begin
  if not Root.Init then
    Fail;
  if Length(Mask) > 127 then
    Fail;
  if Pos(EndChar, Mask) <> 0 then
    Fail;
  maCase := CaseSensitive;
  maMask := Mask;
  SimplifyMask;
  maMask[Length(maMask)+1] := EndChar;
end;

function WildMatcher.Matches(Name : String) : Boolean;
  {-Return True if Name matches Mask}
var
  NLen : Byte absolute Name;
  MPos : Word;
  NPos : Word;
  MPSave : Word;
  NPSave : Word;
  AnyOn : Boolean;
  Ch : Char;
begin
  Matches := False;

  {Add terminator to input string}
  Name[NLen+1] := EndChar;

  AnyOn := False;
  MPos := 1;
  NPos := 1;

  while (maMask[MPos] <> EndChar) or (Name[NPos] <> EndChar) do begin
    {Look for '*'}
    if maMask[MPos] = AnyChar then begin
      if MPos >= Length(maMask) then begin
        {Last character in maMask is '*', rest must match}
        Matches := True;
        Exit;
      end;
      AnyOn := True;
      NPSave := NPos;
      inc(MPos);
      MPSave := MPos;
    end;

    {Get next character from Name string}
    if maCase then
      Ch := Name[NPos]
    else
      Ch := UpCase(Name[NPos]);

    {Look for literal match}
    if (Ch <> EndChar) and ((maMask[MPos] = OneChar) or (maMask[MPos] = Ch))
    then begin
      {Matching character}
      inc(MPos);
      inc(NPos);
    end else begin
      {Mismatched character}
      if not AnyOn or (NPSave >= Length(Name)) then
        {Fatal mismatch, no '*' in effect or no way to advance past mismatch}
        Exit;
      {Increment restart point}
      inc(NPSave);
      {Try again at next Name position}
      NPos := NPSave;
      {Restart maMask just after the '*'}
      MPos := MPSave;
    end;
  end;

  Matches := True;
end;

function WildMatcher.GetMask : String;
  {-Return the simplified mask}
begin
  GetMask := maMask;
end;

procedure WildMatcher.SimplifyMask;
  {-Used internally to simplify mask when object instantiated}
var
  MLen : Byte;
  MPos : Word;
  OMask : String;
  OLen : Byte absolute OMask;
begin
  MLen := Length(maMask);
  MPos := 1;
  OLen := 0;
  while MPos <= MLen do begin
    if (MPos = 1) or (maMask[MPos] <> '*') or (maMask[MPos-1] <> '*') then begin
      {Transfer maMask to OMask, skipping repeated asterisks}
      inc(OLen);
      OMask[OLen] := maMask[MPos];
      if not maCase then
        OMask[OLen] := UpCase(OMask[OLen]);
    end;
    inc(MPos);
  end;
  maMask := OMask;
end;

procedure ScanDir(Dir : PathStr);
  {-Scan one directory}
var
  FRec : SearchRec;

  procedure WriteStatus;
  begin
    Write(StdErr, Dir);
  end;

  procedure ClearStatus;
  begin
    Write(StdErr, ^M, CharStr(' ', Length(Dir)), ^M);
  end;

begin
  WriteStatus;
  FindFirst(AddBackSlash(Dir)+'*.*', FileAttr, FRec);
  while DosError = 0 do begin
    if (FRec.Attr and VolumeID) <> 0 then
      {do nothing for volume labels}
    else if (FRec.Attr and Directory <> 0) then begin
      {a directory, look deeper}
      if (FRec.Name <> '.') and (FRec.Name <> '..') then begin
        ClearStatus;
        ScanDir(AddBackSlash(Dir)+FRec.Name);
        WriteStatus;
      end;
    end else if DefaultMask or FileMask.Matches(FRec.Name) then
      {a matching file, add it to FileTree}
      FileNames.FileInsert(FRec.Name, FRec.Time, FRec.Size, Dir);
    FindNext(FRec);
  end;
  ClearStatus;
end;

procedure ScanDrive(DriveLet : Char);
  {-Scan one drive for duplicate files. DriveLet assumed to be valid}
begin
  ScanDir(DriveLet+':\');
end;

function IsOption(var Param : Word) : Boolean;
  {-Return True if ParamStr(Param) is an option, and evaluate it if so}
var
  Arg : String[127];
begin
  IsOption := False;
  Arg := ParamStr(Param);
  case Arg[1] of
    '/', '-' :
      if Length(Arg) <> 2 then
        Abort('Invalid option: '+Arg)
      else
        case UpCase(Arg[2]) of
          'S' :
             if Param = ParamCount then
               Abort('Missing parameter after: '+Arg)
             else begin
               inc(Param);
               Arg := ParamStr(Param);
               {Validate mask}
               if (Length(Arg) > 12) or
                  (JustFileName(Arg) <> Arg) or
                  (Pos('.', Arg) > 9) then
                 Abort('Invalid file mask: '+Arg);
               FileMask.Init(StUpcase(Arg), True);
               DefaultMask := (FileMask.GetMask = '*.*');
               IsOption := True;
             end;
        else
          Abort('Invalid option: '+Arg);
        end;
  end;
end;

function IsValidDrive(DriveName : String) : Boolean;
  {-Return true if DriveName specifies a valid drive}
begin
  IsValidDrive := False;
  case Length(DriveName) of
    1 : {OK so far};
    2 : {Assure second character is a colon}
     if DriveName[2] <> ':' then
       Exit;
  else
    Exit;
  end;
  IsValidDrive := ValidDrive(Upcase(DriveName[1]));
end;

procedure ValidateDrives;
  {-Assure the requested drives are valid}
var
  Param : Word;
begin
  Param := 1;
  while Param <= ParamCount do begin
    if not IsOption(Param) then
      if not IsValidDrive(ParamStr(Param)) then
        Abort('Invalid drive: '+ParamStr(Param));
    inc(Param);
  end;
end;

procedure ScanDrives;
  {-Scan the requested drives for duplicate files}
var
  Param : Word;
  DriveLet : String[1];
begin
  Param := 1;
  while Param <= ParamCount do begin
    if not IsOption(Param) then begin
      DriveLet := Copy(ParamStr(Param), 1, 1); {Minimize stack usage}
      ScanDrive(UpCase(DriveLet[1]));
    end;
    inc(Param);
  end;
end;

begin
  {StdErr will be used for messages and status}
  if not OpenStdDev(StdErr, StdErrHandle) then
    Halt;

  {Write copyright and help message}
  WriteCopyRight;
  if ParamCount = 0 then
    WriteHelp;

  {The FileNames tree object will store the filenames and their locations}
  FileNames.Init;

  {Scan all files by default}
  DefaultMask := True;

  {Validate the requested drives before scanning anything}
  ValidateDrives;

  {Scan the requested drives}
  ScanDrives;

  {Dump the output}
  FileNames.DumpDups;

  Close(StdErr);
end.